Developer CD Series 1998 May: Tool Chest/Dev.CD May 98 TC.toast/Tool Chest/Development Kits/HyperCard Related/APDA HyperCard Toolkits/HyperCard CTB Toolkit 1.0b2/Source Code/CTBUtil.inc

Text File | 1995-02-07 | 11.2 KB | 413 lines | [TEXT/MPS ]

{        Miscellaneous routines used with the Communication Toolbox XCMDs.

    This file is included in the other Comm Toolbox XCMD source code files -- i.e., it is not compiled and
    linked separately.

    Copyright © 1990 Apple Computer, Inc.

    Initial coding 2/90 by Harry Chesley.
}

procedure Fail(errMsg: Str255); forward;

const

GLOBALNAME = 'xyzzyCTBGlobals';            { Where to store a handle to our globals. }

BUFFERSIZE = 1024;                                    { Connection input buffer used within the XCMD. }

type

{ Tool type: }
ToolType = (connectionTool, terminalTool, fileTransferTool);

{ Handle storage for one tool. }
OneToolType =
    record
        case tType: ToolType of
            connectionTool: (cHand: ConnHandle);            { A connection tool. }
            terminalTool: (tHand: TermHandle);                { A terminal tool. }
            fileTransferTool: (ftHand: FTHandle)                { A file transfer tool. }
    end;

ToolArray = array [1..1000] of OneToolType;

{ An input buffer. }
InputBufferType =
    record
        bufferPtr: Ptr;                                                    { Pointer to next byte to get from buffer. }
        amountLeft: longInt;                                            { Number of bytes left in the buffer. }
        timeOut: longInt;                                                { How long to try before timing out. }
        termString: Handle;                                            { String to stop receiving after. }
        termOffset: longInt;                                            { How much of the termString we've seen. }
        recvLimit: longInt;                                            { Max. number of chars to receive at once. }
        doStrip: boolean;                                                { Strip controls & top bit. }
        buffer: array [1..BUFFERSIZE] of SignedByte;    { The input buffer. }
    end;

InputBufferPtr = ^InputBufferType;
InputBufferHandle = ^InputBufferPtr;

{ Global data: }
OurGlobalType =
    record
        connHand: ConnHandle;            { Connection tool handle. }
        termHand: TermHandle;        { Terminal tool handle. }
        FTHand: FTHandle;                { File transfer tool handle. }
        allToolsSize: integer;            { Number of outstanding tools. }
        allTools: ToolArray;                { Array of outstanding tools (extended dynamically). }
    end;

OurGlobalPtr = ^OurGlobalType;
OurGlobalHandle = ^OurGlobalPtr;

var

{ Global data. (Note: Although this is called global, it's actually allocated as local to the top-level
    XCMD routine, and therefore only stays around for the duration of the XCMD execution. Being
    able to think of it as globals, and not having to pass it to each subroutine called, however, is
    extremely useful. This is perhaps the best reason for using Pascal rather than C for writing
    XCMDs.) }

Globals: OurGlobalHandle;        { Global data (this handle is saved in a HyperTalk global between XCMDs). }

function TrapAvailable(tNumber: integer; tType: TrapType): boolean;
    { Return true if the indicated trap is installed. }

    const _UnimplementedToolTrap = $A89F;
        _UnimplementedOSTrap = $9F;

    var unImplemented: integer;

    begin
        if tType = OSTrap then unImplemented := _UnimplementedOSTrap
        else unImplemented := _UnimplementedToolTrap;
        TrapAvailable := NGetTrapAddress(tNumber, tType) <> GetTrapAddress(unImplemented);
    end;

procedure FailOSErr(err: OSErr);
    { Check for an error return and fail if there is one. }

    var s: Str255;

    begin
        if err <> noErr then
            begin
                LongToStr(paramPtr,err,s);
                Fail(Concat('Failed due to OS error ',s));
            end;
    end;

procedure GetStrGlobal(name: str255; var glob: str255);
    { Set glob to the global string specified by name. }

    var globHand: Handle;

    begin
        { Get the HyperTalk global. }
        globHand := GetGlobal(paramPtr,name);
        { Convert it to a Pascal string. }
        if globHand = nil then glob := ''
        else
            begin
                ZeroToPas(paramPtr,globHand^,glob);
                DisposHandle(globHand);
            end;
    end;

function GetLongGlobal(name: str255): longInt;
    { Return the global string specified by name, interpreted as a long integer. }

    var globStr: str255;

    begin
        { Get the HyperTalk global into a Pascal string. }
        GetStrGlobal(name,globStr);
        { Convert it to a longInt. }
        GetLongGlobal := StrToLong(paramPtr,globStr);
    end;

procedure SetStrGlobal(name: str255; glob: str255);
    { Set the global string specified by name to glob. }

    var globHand: Handle;

    begin
        { Convert the string to a HyperTalk style handle-string. }
        globHand := PasToZero(paramPtr,glob);
        { Set the global. }
        SetGlobal(paramPtr,name,globHand);
        { Dispose of our copy. }
        DisposHandle(globHand);
    end;

procedure SetLongGlobal(name: str255; globLong: longInt);
    {Set the global string specified by name to a string that represents the number in globLong. }

    var globStr: str255;

    begin
        { Convert the longInt to a Pascal string. }
        LongToStr(paramPtr,globLong,globStr);
        { Set the HyperTalk global to that. }
        SetStrGlobal(name,globStr);
    end;

procedure GetStrParm(n: integer; var str: str255);
    { Get the nth parameter into str. }

    begin
        if paramPtr^.params[n] = nil then str := ''
        else ZeroToPas(paramPtr,paramPtr^.params[n]^,str);
    end;

function GetLongParm(n: integer): longInt;
    { Return the nth parameter string, interpreted as a long integer. }

    var str: str255;

    begin
        ZeroToPas(paramPtr,paramPtr^.params[n]^,str);
        GetLongParm := StrToNum(paramPtr,str);
    end;

function GetToolTypeParm(n: integer): ToolType;
    { Return the type of the tool specified by parameter n ("connection", "terminal", or "file transfer"). }

    var ch: Char;

    begin
        ch := Chr(paramPtr^.params[n]^^);
        if (ch = 't') or (ch = 'T') then GetToolTypeParm := terminalTool
        else if (ch = 'f') or (ch = 'F') then GetToolTypeParm := fileTransferTool
        else GetToolTypeParm := connectionTool;
    end;

function ParmPresent(n: integer): boolean;
    { Return true if the parameter is present and non-empty. }

    var s: Str255;

    begin
        if n > paramPtr^.paramCount then ParmPresent := false
        else
            begin
                GetStrParm(n,s);
                if s = '' then ParmPresent := false
                else ParmPresent := true;
            end;
    end;

function min(l1, l2: longInt): longInt;

    begin
        if l1 < l2 then min := l1
        else min := l2;
    end;

function max(l1, l2: longInt): longInt;

    begin
        if l1 > l2 then max := l1
        else max := l2;
    end;

function CTBInstalled: boolean;
    { Return true if the Comm Toolbox is installed. }

    const _CommToolboxTrap = $8B;

    begin
        CTBInstalled := TrapAvailable(_CommToolboxTrap, OSTrap);
    end;

procedure CTBReady;
    { If we haven't been here before, create the handle we use for our global variables,
        remember it in a HyperCard global, and call the Comm Toolbox init routines. Also,
        give all the outstanding tools some idle time (since all the XCMDs call CTBReady,
        this insures that everyone gets idle from time to time, so long as the user
        calls some XCMD). }

    var ignore: integer;
        i: integer;

    procedure idleOne(theTool: OneToolType);
        { Give the tool idle time. }

        var sizes: CMBufferSizes;
            status: CMStatFlags;

        begin
            case theTool.tType of
                connectionTool:
                    begin
                        { Idle the connection. }
                        CMIdle(theTool.cHand);
                        { If there's an incoming connection request, answer it. }
                        FailOSErr(CMStatus(theTool.cHand,sizes,status));
                        if BAnd(status,cmStatusIncomingCallPresent) <> 0 then
                            FailOSErr(CMAccept(theTool.cHand,true));
                    end;
                terminalTool:
                    { Idle the terminal tool. }
                    TMIdle(theTool.tHand);
                end;
        end;

    begin
        { Get the value of the global that holds our globals handle. }
        Globals := OurGlobalHandle(GetLongGlobal(GLOBALNAME));
        { If it's empty (which will evaluate to zero or nil), then we need to create it. }
        if Globals = nil then
            begin
                { Make sure the Toolbox is here. }
                if not CTBInstalled then Fail('Comm Toolbox not installed');
                { Make the handle. }
                Globals := OurGlobalHandle(NewHandle(sizeof(OurGlobalType)-sizeof(ToolArray)));
                if Globals = nil then Fail('Could not allocate global variable space');
                { Remember it in a HyperCard global. }
                SetLongGlobal(GLOBALNAME,ord4(Globals));
                { Default to nothing happenin'. }
                with Globals^^ do
                    begin
                        connHand := nil;
                        termHand := nil;
                        FTHand := nil;
                        allToolsSize := 0;
                    end;
                { Initialize the Comm Toolbox. }
                ignore := InitCTBUtilities;
                ignore := InitCRM;
                ignore := InitCM;
                ignore := InitTM;
                ignore := InitFT;
            end;
        { Now idle everyone. }
        for i := 1 to Globals^^.allToolsSize do idleOne(Globals^^.allTools[i]);
    end;

procedure DeallocateGlobals;

    begin
        DisposHandle(Handle(Globals));
        SetLongGlobal(GLOBALNAME,0)
    end;

procedure EnsurePresent(tt: ToolType);
    { Check if there is a handle of the right tool type. If not, fail. }

    var noGood: boolean;

    begin
        noGood := false;
        if ((tt = connectionTool) and (Globals^^.connHand = nil)) or
            ((tt = terminalTool) and (Globals^^.termHand = nil)) or
            ((tt = fileTransferTool) and (Globals^^.FTHand = nil)) then Fail('Error: must do New first');
    end;

procedure EnsureOpen;
    { Check if the connection is open. If it isn't, then open it now. }

    var sizes: CMBufferSizes;
        status: CMStatFlags;

    begin
        { Is it already open? }
        FailOSErr(CMStatus(Globals^^.connHand,sizes,status));
        { If not, open it. }
        if BAnd(status,cmStatusOpen+cmStatusOpening) = 0 then
            FailOSErr(CMOpen(Globals^^.connHand,false,nil,-1));
    end;

function ReadFromConn(buf: Ptr; sz: longInt): longInt;
    { Read sz bytes from the current connection into the buffer pointed to by buf. }

    var toRead: longInt;
        l, l2: longInt;
        p: Ptr;
        flags: CMFlags;

    begin
        { Read the bytes into the buffer. }
        toRead := sz;
        if CMRead(Globals^^.connHand,buf,toRead,cmData,false,nil,-1,flags) <> noErr then
            Fail('Read failed');
        { If there's a terminal emulator present, feed the bytes to it as well. }
        if Globals^^.termHand <> nil then
            begin
                { Loop in case it doesn't eat them all in one gulp. }
                p := buf;
                l := toRead;
                while l > 0 do
                    begin
                        l2 := TMStream(Globals^^.termHand,p,l,flags);
                        p := Ptr(ord4(p)+l2);
                        l := l - l2;
                    end;
            end;
        { Return the number we actually succeeded in reading. }
        ReadFromConn := toRead;
    end;

procedure StripBytes(h: Handle; sz: longInt; doStrip: boolean);
    { Mung a handle of data around to the right format to return to HyperCard. Truncate it
        so there's only sz bytes plus a zero termination. Add the zero termination. If doStrip
        is true, strip off control characters other than tab and return, and clear the top bit
        of each byte. If doStrip is false, replace nulls (which would terminate a HyperCard
        string) with "¿"s. }

    var p, p2: Ptr;
        b: SignedByte;
        l: longInt;
        newSz: longInt;

    begin
        { To strip or not to strip... }
        if doStrip then
            begin
                { Cycle through all the bytes. }
                p := h^;
                p2 := p;
                l := sz;
                newSz := 0;
                while l > 0 do
                    begin
                        { Strip the top bit. }
                        b := p^;
                        b := BAnd(b,$7F);
                        { If it's not a control character or is a tab or a return, keep it. }
                        if (b >= ord(' ')) or (b = 9) or (b = 13) then
                            begin
                                p2^ := b;
                                p2 := Ptr(ord4(p2)+1);
                                newSz := newSz+1;
                            end;
                        p := Ptr(ord4(p)+1);
                        l := l-1;
                    end;
                { Set the handle size appropriately. }
                SetHandleSize(h,newSz+1);
                { Add in the termination null. }
                p2 := Ptr(ord4(h^) + newSz);
                p2^ := 0;
            end
        else
            begin
                { Cycle through looking for nulls. }
                p := h^;
                l := sz;
                while l > 0 do
                    begin
                        { If we find a null, eradicate it. }
                        if p^ = 0 then p^ := ord('¿');
                        p := Ptr(ord4(p)+1);
                        l := l-1;
                    end;
                { Set the handle size appropriately. }
                SetHandleSize(h,sz+1);
                { Add in the termination null. }
                p := Ptr(ord4(h^) + sz);
                p^ := 0;
            end;
    end;